Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/dragpic2/form1.frm

Visual Basic Form | 1998-04-06 | 5.3 KB | 168 lines

VERSION 4.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   5865
   ClientLeft      =   1275
   ClientTop       =   1530
   ClientWidth     =   3840
   Height          =   6270
   Left            =   1215
   LinkTopic       =   "Form1"
   ScaleHeight     =   5865
   ScaleWidth      =   3840
   Top             =   1185
   Width           =   3960
   Begin VB.CheckBox chkUseOutline
      Caption         =   "Use Outline"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   1455
   End
   Begin VB.PictureBox picMask
      AutoRedraw      =   -1  'True
      Height          =   1665
      Left            =   3360
      Picture         =   "Form1.frx":0000
      ScaleHeight     =   107
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   91
      TabIndex        =   2
      Top             =   2640
      Visible         =   0   'False
      Width           =   1425
   End
   Begin VB.PictureBox picImage
      AutoRedraw      =   -1  'True
      Height          =   1665
      Left            =   3360
      Picture         =   "Form1.frx":739E
      ScaleHeight     =   107
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   91
      TabIndex        =   1
      Top             =   840
      Visible         =   0   'False
      Width           =   1425
   End
   Begin VB.PictureBox picBackground
      AutoRedraw      =   -1  'True
      Height          =   5385
      Left            =   1680
      Picture         =   "Form1.frx":E73C
      ScaleHeight     =   355
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   251
      TabIndex        =   0
      Top             =   1800
      Visible         =   0   'False
      Width           =   3825
   End
   Begin VB.PictureBox picCanvas
      AutoRedraw      =   -1  'True
      DrawMode        =   6  'Mask Pen Not
      Height          =   5385
      Left            =   0
      ScaleHeight     =   355
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   251
      TabIndex        =   3
      Top             =   480
      Width           =   3825
   End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCAND = &H8800C6
Private Const MERGEPAINT = &HBB0226
' Set false to draw the picture. It's slower.
Private UseOutline As Boolean
' The canvas's dimensions.
Private CanvasWid As Single
Private CanvasHgt As Single
' The picture's dimensions.
Private PicWid As Single
Private PicHgt As Single
' The picture's current position.
Private PicX As Single
Private PicY As Single
' Are we dragging?
Private Dragging As Boolean
Private OffsetX As Single
Private OffsetY As Single
' Draw the picture.
Private Sub DrawPic()
    picCanvas.Picture = picBackground.Picture
'    picCanvas.PaintPicture picMask.Picture, _
'        PicX, PicY, PicWid, PicHgt, _
'        0, 0, PicWid, PicHgt, vbMergePaint
    BitBlt picCanvas.hDC, _
        PicX, PicY, PicWid, PicHgt, _
        picMask.hDC, _
        0, 0, MERGEPAINT
'    picCanvas.PaintPicture picImage.Picture, _
'        PicX, PicY, PicWid, PicHgt, _
'        0, 0, PicWid, PicHgt, vbSrcAnd
    BitBlt picCanvas.hDC, _
        PicX, PicY, PicWid, PicHgt, _
        picImage.hDC, _
        0, 0, SRCAND
    picCanvas.Picture = picCanvas.Image
End Sub
' Draw an outline of the picture.
Private Sub DrawOutline()
    picCanvas.Line _
        (PicX, PicY)-Step(PicWid, PicHgt), , B
End Sub
' Draw the initial picture.
Private Sub Form_Load()
    CanvasWid = picCanvas.ScaleWidth
    CanvasHgt = picCanvas.ScaleHeight
    PicWid = picImage.ScaleWidth
    PicHgt = picImage.ScaleHeight
    PicX = PicWid
    PicY = PicHgt
    DrawPic
End Sub
' See if the mouse is over a point corresponding
' to a black part of the mask.
Private Sub picCanvas_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    OffsetX = PicX - x
    OffsetY = PicY - y
    If picMask.Point(-OffsetX, -OffsetY) <> vbBlack Then Exit Sub
    ' Start dragging.
    UseOutline = (chkUseOutline.Value = vbChecked)
    If UseOutline Then DrawOutline
    Dragging = True
End Sub
' Drag.
Private Sub picCanvas_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not Dragging Then Exit Sub
    If UseOutline Then DrawOutline
    PicX = x + OffsetX
    If PicX < 0 Then
        PicX = 0
    ElseIf PicX > CanvasWid - PicWid Then
        PicX = CanvasWid - PicWid
    End If
    PicY = y + OffsetY
    If PicY < 0 Then
        PicY = 0
    ElseIf PicY > CanvasHgt - PicHgt Then
        PicY = CanvasHgt - PicHgt
    End If
    If UseOutline Then
        DrawOutline
    Else
        DrawPic
    End If
End Sub
' Stop dragging.
Private Sub picCanvas_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If UseOutline Then DrawPic
    Dragging = False
End Sub